IRT
Mar??a Jos?? Beltr??n
5/6/2021
IRT
library(tidyverse)
library(ggplot2)
library(dplyr)
library(lubridate)
library(plyr)
library(cluster)
library(MASS)
library(readxl)
library(gridExtra)Importamos los datos. Nos quedamos unicamente con las respuestas a las 33 preguntas de cada alumno (4to curso UIB y Valencia)
datosValencia_T1 <- read_excel("/Users/MariaJose/Desktop/TFG/Encuesta/PID_E_II_control3_T1T2T3_4codificado-1.xlsx", sheet = "control3_T1", range = cell_cols("AN:BT")) %>%
dplyr::rename(Pregunta_1 = "1. Me resulta facil darme cuenta de las intenciones de las personas que me rodean",
Pregunta_2 = "2. Me siento bien si los demas se divierten (lo pasan bien)",
Pregunta_3 = "3. No me pongo triste solo porque un amigo lo este",
Pregunta_4 = "4. Si un amigo consigue un trabajo muy deseado, me entusiasmo con el",
Pregunta_5 = "5. Me afecta demasiado ver programas de television donde se muestran los problemas de otras personas",
Pregunta_6 = "6. Antes de tomar una decision, intento tener en cuenta todos los puntos de vista",
Pregunta_7 = "7. Rara vez reconozco como se siente una persona con solo mirarla",
Pregunta_8 = "8. Me afecta poco escuchar desgracias sobre personas desconocidas",
Pregunta_9 = "9. Me hace ilusion ver que un amigo nuevo se encuentra a gusto en nuestro grupo",
Pregunta_10 = "10. Me es dificil entender como se siente una persona ante una situacion que no he vivido",
Pregunta_11 = "11. Cuando un amigo se ha portado mal conmigo, intento entender los motivos por los que lo ha hecho",
Pregunta_12 = "12. A menos que se trate de algo muy grave, me cuesta llorar con lo que les sucede a otros",
Pregunta_13 = "13. Reconozco facilmente cuando alguien esta de mal humor",
Pregunta_14 = "14. No siempre me doy cuenta cuando la persona que tengo al lado se siente mal",
Pregunta_15 = "15. Intento ponerme en el lugar de los demas para saber como actuaran",
Pregunta_16 = "16. Cuando a alguien le sucede algo bueno, siento alegria",
Pregunta_17 = "17. Si tengo una opinion formada no presto mucha atencion a los argumentos de los demas",
Pregunta_18 = "18. A veces sufro mas con las desgracias de los demas que ellos mismos",
Pregunta_19 = "19. Me siento feliz solo con ver felices a otras personas",
Pregunta_20 = "20. Cuando alguien tiene un problema, intento imaginarme como me sentiria si estuviera en su lugar",
Pregunta_21 = "21. No siento especial alegria si alguien me cuenta que ha tenido un golpe de suerte",
Pregunta_22 = "22. Cuando veo que alguien recibe un regalo no puedo reprimir una sonrisa",
Pregunta_23 = "23. No puedo evitar llorar con los testimonios de personas desconocidas",
Pregunta_24 = "24. Cuando conozco gente nueva me doy cuenta de la impresion que se han llevado de mi",
Pregunta_25 = "25. Cuando mis amigos me cuentan que les va bien, no le doy mucha importancia",
Pregunta_26 = "26. Encuentro dificil ver las cosas desde el punto de vista de otras personas",
Pregunta_27 = "27. Entender como se siente otra persona es algo muy facil para mi",
Pregunta_28 = "28. No soy de esas personas que se deprimen con los problemas de los demas",
Pregunta_29 = "29. Intento comprender mejor a mis amigos mirando las situaciones desde su perspectiva",
Pregunta_30 = "30. Me considero una persona fria porque no me conmuevo facilmente",
Pregunta_31 = "31. Me doy cuenta cuando las personas cercanas a mi estan especialmente contentas, aunque no me hayan contado el motivo",
Pregunta_32 = "32. Me resulta dificil ponerme en el lugar de personas con las que no estoy de acuerdo",
Pregunta_33 = "33. Me doy cuenta cuando alguien intenta esconder sus verdaderos sentimientos")datosUIB_T1 <- read_excel("/Users/MariaJose/Desktop/TFG/Encuesta/PID_E_II_int4_T1T2T3_prog_intensivo_4codificado.xlsx", sheet = "EII_int_T1", range = cell_cols("AN:BT")) %>%
dplyr::rename(Pregunta_1 = '1TECA1', Pregunta_2 = '1TECA2', Pregunta_3 = '1TECA3',Pregunta_4 = '1TECA4', Pregunta_5 = '1TECA5', Pregunta_6 = '1TECA6', Pregunta_7 = '1TECA7', Pregunta_8 = '1TECA8', Pregunta_9 = '1TECA9', Pregunta_10 = '1TECA10', Pregunta_11 = '1TECA11', Pregunta_12 = '1TECA12', Pregunta_13 = '1TECA13', Pregunta_14 = '1TECA14', Pregunta_15 = '1TECA15', Pregunta_16 = '1TECA16', Pregunta_17 = '1TECA17',Pregunta_18 = '1TECA18', Pregunta_19 = '1TECA19', Pregunta_20 = '1TECA20', Pregunta_21 = '1TECA21',Pregunta_22 = '1TECA22', Pregunta_23 = '1TECA23',Pregunta_24 = '1TECA24', Pregunta_25 = '1TECA25', Pregunta_26 = '1TECA26', Pregunta_27 = '1TECA27', Pregunta_28 = '1TECA28', Pregunta_29 = '1TECA29', Pregunta_30 = '1TECA30', Pregunta_31 = '1TECA31', Pregunta_32 = '1TECA32', Pregunta_33 = '1TECA33')Juntamos los datos
Invertimos el orden de las respuestas para las preguntas necesarias
Convertimos los "0" en NA.
datos_T1[datos_T1 == "0"] <- NA#Adopcion de perspectivas
AP <- dplyr::select(datos_T1, Pregunta_6, Pregunta_11, Pregunta_15, Pregunta_17, Pregunta_20, Pregunta_26, Pregunta_29, Pregunta_32)
#Comprension emocional
CE <- dplyr::select(datos_T1, Pregunta_1, Pregunta_7, Pregunta_10, Pregunta_13, Pregunta_14, Pregunta_24, Pregunta_27, Pregunta_31, Pregunta_33)
#Estres empatico
EE <- dplyr::select(datos_T1, Pregunta_3, Pregunta_5, Pregunta_8, Pregunta_12, Pregunta_18, Pregunta_23, Pregunta_28, Pregunta_30)
#Alegria empatica
AE <- dplyr::select(datos_T1, Pregunta_2, Pregunta_4, Pregunta_9, Pregunta_16, Pregunta_19, Pregunta_21, Pregunta_22, Pregunta_25)#ADOPCION PERSPECTIVAS
#P6 (Falta 1)
AP$Pregunta_6[AP$Pregunta_6 == "2"] <- "1"
AP$Pregunta_6[AP$Pregunta_6 == "3"] <- "2"
AP$Pregunta_6[AP$Pregunta_6 == "4"] <- "3"
AP$Pregunta_6[AP$Pregunta_6 == "5"] <- "4"#COMPRENSION EMOCIONAL
#P13 (Falta 1)
CE$Pregunta_13[CE$Pregunta_13 == "2"] <- "1"
CE$Pregunta_13[CE$Pregunta_13 == "3"] <- "2"
CE$Pregunta_13[CE$Pregunta_13 == "4"] <- "3"
CE$Pregunta_13[CE$Pregunta_13 == "5"] <- "4"#ALEGRIA EMPATICA
#P2 (Falta 1)
AE$Pregunta_2[AE$Pregunta_2 == "2"] <- "1"
AE$Pregunta_2[AE$Pregunta_2 == "3"] <- "2"
AE$Pregunta_2[AE$Pregunta_2 == "4"] <- "3"
AE$Pregunta_2[AE$Pregunta_2 == "5"] <- "4"
#P4 (Falta 1)
AE$Pregunta_4[AE$Pregunta_4 == "2"] <- "1"
AE$Pregunta_4[AE$Pregunta_4 == "3"] <- "2"
AE$Pregunta_4[AE$Pregunta_4 == "4"] <- "3"
AE$Pregunta_4[AE$Pregunta_4 == "5"] <- "4"
#P9 (Falta 1)
AE$Pregunta_9[AE$Pregunta_9 == "2"] <- "1"
AE$Pregunta_9[AE$Pregunta_9 == "3"] <- "2"
AE$Pregunta_9[AE$Pregunta_9 == "4"] <- "3"
AE$Pregunta_9[AE$Pregunta_9 == "5"] <- "4"Procedemos a aplicar el modelo IRT
library(ltm)## Loading required package: msm## Loading required package: polycor#Adopcion perspectivas
irt_AP <- grm(AP)
summary(irt_AP)##
## Call:
## grm(data = AP)
##
## Model Summary:
## log.Lik AIC BIC
## -1211.361 2500.723 2611.027
##
## Coefficients:
## $Pregunta_6
## value
## Extrmt1 -3.688
## Extrmt2 -1.055
## Extrmt3 1.168
## Dscrmn 0.957
##
## $Pregunta_11
## value
## Extrmt1 -5.969
## Extrmt2 -3.409
## Extrmt3 -0.279
## Extrmt4 2.555
## Dscrmn 0.702
##
## $Pregunta_15
## value
## Extrmt1 -3.265
## Extrmt2 -2.631
## Extrmt3 -0.674
## Extrmt4 0.973
## Dscrmn 1.459
##
## $Pregunta_17
## value
## Extrmt1 -5.365
## Extrmt2 -2.305
## Extrmt3 0.024
## Extrmt4 2.437
## Dscrmn 0.816
##
## $Pregunta_20
## value
## Extrmt1 -3.271
## Extrmt2 -1.998
## Extrmt3 -0.261
## Extrmt4 1.131
## Dscrmn 1.478
##
## $Pregunta_26
## value
## Extrmt1 -3.315
## Extrmt2 -1.927
## Extrmt3 -0.513
## Extrmt4 0.854
## Dscrmn 1.284
##
## $Pregunta_29
## value
## Extrmt1 -2.175
## Extrmt2 -1.776
## Extrmt3 -0.542
## Extrmt4 0.901
## Dscrmn 4.198
##
## $Pregunta_32
## value
## Extrmt1 -4.408
## Extrmt2 -1.735
## Extrmt3 0.118
## Extrmt4 2.955
## Dscrmn 0.716
##
##
## Integration:
## method: Gauss-Hermite
## quadrature points: 21
##
## Optimization:
## Convergence: 0
## max(|grad|): 1.1
## quasi-Newton: BFGSplot(irt_AP)
plot(irt_AP, type="IIC") 
#Comprension emocional
irt_CE <- grm(CE)
summary(irt_CE)##
## Call:
## grm(data = CE)
##
## Model Summary:
## log.Lik AIC BIC
## -1358.626 2805.252 2929.697
##
## Coefficients:
## $Pregunta_1
## value
## Extrmt1 -5.023
## Extrmt2 -2.298
## Extrmt3 -0.193
## Extrmt4 2.020
## Dscrmn 1.070
##
## $Pregunta_7
## value
## Extrmt1 -6.450
## Extrmt2 -2.681
## Extrmt3 0.314
## Extrmt4 2.840
## Dscrmn 0.668
##
## $Pregunta_10
## value
## Extrmt1 -3.851
## Extrmt2 -1.941
## Extrmt3 0.150
## Extrmt4 2.123
## Dscrmn 0.916
##
## $Pregunta_13
## value
## Extrmt1 -3.415
## Extrmt2 -1.049
## Extrmt3 0.541
## Dscrmn 1.838
##
## $Pregunta_14
## value
## Extrmt1 -3.434
## Extrmt2 -2.477
## Extrmt3 -0.228
## Extrmt4 2.004
## Dscrmn 0.965
##
## $Pregunta_24
## value
## Extrmt1 -3.614
## Extrmt2 -1.236
## Extrmt3 1.089
## Extrmt4 3.252
## Dscrmn 0.921
##
## $Pregunta_27
## value
## Extrmt1 -2.346
## Extrmt2 -1.190
## Extrmt3 -0.087
## Extrmt4 1.380
## Dscrmn 2.156
##
## $Pregunta_31
## value
## Extrmt1 -3.057
## Extrmt2 -2.060
## Extrmt3 -0.609
## Extrmt4 0.822
## Dscrmn 2.234
##
## $Pregunta_33
## value
## Extrmt1 -2.345
## Extrmt2 -1.292
## Extrmt3 0.037
## Extrmt4 1.456
## Dscrmn 2.107
##
##
## Integration:
## method: Gauss-Hermite
## quadrature points: 21
##
## Optimization:
## Convergence: 0
## max(|grad|): 0.0082
## quasi-Newton: BFGSplot(irt_CE)
plot(irt_CE, type="IIC")
#Estres empatico
irt_EE <- grm(EE)
summary(irt_EE)##
## Call:
## grm(data = EE)
##
## Model Summary:
## log.Lik AIC BIC
## -1390.672 2861.345 2974.477
##
## Coefficients:
## $Pregunta_3
## value
## Extrmt1 -3.730
## Extrmt2 -0.832
## Extrmt3 1.803
## Extrmt4 4.857
## Dscrmn 0.641
##
## $Pregunta_5
## value
## Extrmt1 -1.778
## Extrmt2 -0.174
## Extrmt3 0.916
## Extrmt4 2.971
## Dscrmn 1.123
##
## $Pregunta_8
## value
## Extrmt1 -4.147
## Extrmt2 -2.103
## Extrmt3 -0.554
## Extrmt4 1.654
## Dscrmn 0.858
##
## $Pregunta_12
## value
## Extrmt1 -1.727
## Extrmt2 -0.537
## Extrmt3 0.344
## Extrmt4 1.601
## Dscrmn 1.382
##
## $Pregunta_18
## value
## Extrmt1 -1.887
## Extrmt2 0.109
## Extrmt3 1.560
## Extrmt4 3.586
## Dscrmn 0.924
##
## $Pregunta_23
## value
## Extrmt1 -1.099
## Extrmt2 0.182
## Extrmt3 1.373
## Extrmt4 2.381
## Dscrmn 1.593
##
## $Pregunta_28
## value
## Extrmt1 -1.478
## Extrmt2 -0.342
## Extrmt3 0.776
## Extrmt4 2.483
## Dscrmn 1.960
##
## $Pregunta_30
## value
## Extrmt1 -3.425
## Extrmt2 -1.612
## Extrmt3 -0.610
## Extrmt4 0.786
## Dscrmn 1.209
##
##
## Integration:
## method: Gauss-Hermite
## quadrature points: 21
##
## Optimization:
## Convergence: 0
## max(|grad|): 0.015
## quasi-Newton: BFGSplot(irt_EE)
plot(irt_EE, type="IIC")
#Alegria empatica
irt_AE <- grm(AE)
summary(irt_AE)##
## Call:
## grm(data = AE)
##
## Model Summary:
## log.Lik AIC BIC
## -1047.384 2168.768 2273.415
##
## Coefficients:
## $Pregunta_2
## value
## Extrmt1 -2.886
## Extrmt2 -1.263
## Extrmt3 0.111
## Dscrmn 2.512
##
## $Pregunta_4
## value
## Extrmt1 -2.866
## Extrmt2 -1.402
## Extrmt3 0.110
## Dscrmn 2.405
##
## $Pregunta_9
## value
## Extrmt1 -2.853
## Extrmt2 -1.139
## Extrmt3 0.153
## Dscrmn 2.655
##
## $Pregunta_16
## value
## Extrmt1 -2.900
## Extrmt2 -2.548
## Extrmt3 -1.058
## Extrmt4 0.354
## Dscrmn 2.501
##
## $Pregunta_19
## value
## Extrmt1 -2.518
## Extrmt2 -1.740
## Extrmt3 -0.516
## Extrmt4 1.170
## Dscrmn 1.825
##
## $Pregunta_21
## value
## Extrmt1 -2.817
## Extrmt2 -1.533
## Extrmt3 -0.313
## Extrmt4 1.388
## Dscrmn 1.276
##
## $Pregunta_22
## value
## Extrmt1 -3.384
## Extrmt2 -2.479
## Extrmt3 -0.899
## Extrmt4 1.447
## Dscrmn 1.022
##
## $Pregunta_25
## value
## Extrmt1 -5.091
## Extrmt2 -2.899
## Extrmt3 -1.391
## Extrmt4 0.213
## Dscrmn 1.038
##
##
## Integration:
## method: Gauss-Hermite
## quadrature points: 21
##
## Optimization:
## Convergence: 0
## max(|grad|): 0.0097
## quasi-Newton: BFGSplot(irt_AE)
plot(irt_AE, type = "IIC")